home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 8 / FM Towns Free Software Collection 8.iso / t_os / taikei / taikei.bas < prev    next >
BASIC Source File  |  1994-06-01  |  4KB  |  130 lines
  1. 1000 'SAVE "TAIKEI.BAS"
  2. 1010 ' 
  3. 1020 '     [｢ 私の体型は｣　プログラム ]
  4. 1030 '
  5. 1040 '            by 火事くん
  6. 1050 '
  7. 1060 '-------------------------------------------------------
  8. 1070 '
  9. 1080     CLEAR ,,512,520000
  10. 1090     WIDTH 80,20:CONSOLE 0,20:SCREEN@ 0:MOUSE 0:STOP OFF
  11. 1100     DEFINT A-B,D-Z
  12. 1110     DEF FNN$(DM)=AKCNV$(STR$(DM))
  13. 1120      ON ERROR GOTO *ERRO
  14. 1130      DIM KOE%(220000),S1%(1000),S2%(1000),S3%(1000),S4%(1000)
  15. 1140      DIM S5%(3000),KDOCH%(.31!*19200/2+16)
  16. 1150    COLOR 7,0,,4:CLS
  17. 1160    LOAD@ "DOCH.SND",KDOCH%
  18. 1170    LOAD@ "MAN.TIF"
  19. 1180    GET@A (558,2)-(637,100),S5%
  20. 1190    LINE (558,2)-(637,100),PSET,%15,BF
  21. 1200    LOAD@ "DOUZO_F.SND",KOE%:PCMPLAY KOE%,127:WAIT 80
  22. 1210            GOSUB 2140
  23. 1220            GOSUB *INIT
  24. 1230            GOSUB *IDOU
  25. 1240            GOSUB *DOCH
  26. 1250 ' 
  27. 1260 *INIT 
  28. 1270   NO=0
  29. 1280   LOCATE 50,1:PRINT SPC(20):LOCATE 50,2:PRINT SPC(20)
  30. 1290    LOAD@ "SINCH.SND",KOE%:PCMPLAY KOE%,127:WAIT 53
  31. 1300   SW=1:X=54:Y=1:ST=5:S=100:M=195:GOSUB *KAZU
  32. 1310   IF DM$="" THEN 1300 ELSE CM=VAL(DM$):COLOR 7
  33. 1320 '
  34. 1330   NO=0
  35. 1340    LOAD@ "TAIGI.SND",KOE%:PCMPLAY KOE%,127:WAIT 47
  36. 1350   SW=2:X=56:Y=2:ST=4:S=15:M=99.9!:GOSUB *KAZU
  37. 1360   IF DM$="" THEN 1350 ELSE KG=VAL(DM$):COLOR 7
  38. 1370 RETURN
  39. 1380 '
  40. 1390 *IDOU
  41. 1400   PLAY "O5C"
  42. 1410 '
  43. 1420   SPEED=3:SWOV=0
  44. 1430   SX=0   :SY=354:STEP0=1
  45. 1440   DX=5*STEP0    :DY=0
  46. 1450   INCX=27:INCY=30
  47. 1460   ROL=INT(KG/CM/CM/CM*10000000)
  48. 1470  IF ROL<35 OR ROL>200 THEN ELSE 1510
  49. 1480    LOAD@ "DAMEYO_F.SND",KOE%:PCMPLAY KOE%,127:WAIT 76
  50. 1490    SWOV=1
  51. 1500  GOTO 2060
  52. 1510    GET@A (SX,SY)-(SX+INCX,SY+INCY),S1%
  53. 1520    LINE (SX,SY)-(SX+INCX,SY+INCY),PSET,7,BF
  54. 1530   FOR I=70 TO (ROL-3) STEP STEP0
  55. 1540      SX=SX+DX:SY=SY+DY
  56. 1550    GET@A (SX,SY)-(SX+INCX,SY+INCY),S2%
  57. 1560    PUT@A (SX,SY)-(SX+INCX,SY+INCY),S1%,PSET
  58. 1570         BEEP 0:BEEP 1:WAIT SPEED:BEEP 0
  59. 1580    PUT@A (SX,SY)-(SX+INCX,SY+INCY),S2%,PSET
  60. 1590   NEXT
  61. 1600    PUT@A (SX,SY)-(SX+INCX,SY+INCY),S1%,PSET
  62. 1610 '
  63. 1620   IF ROL<100 THEN XK=50
  64. 1630   IF ROL>=100 AND ROL<115 THEN XK=160
  65. 1640   IF ROL>=115 AND ROL<145 THEN XK=275
  66. 1650   IF ROL>=145 AND ROL<160 THEN XK=385
  67. 1660   IF ROL>=160 THEN XK=520
  68. 1670 '
  69. 1680   SY0=463:SY1=124:WX=50:WY=479-SY0
  70. 1690    GET@A (XK,SY1)-(XK+WX,SY1+WY),S4%
  71. 1700    GET@A (XK,SY0)-(XK+WX,SY0+WY),S3%
  72. 1710    LINE (XK,SY0)-(XK+WX,SY0+WY),PSET,7,BF
  73. 1720    PUT@A (XK,SY1)-(XK+WX,SY1+WY),S3%
  74. 1730    PAINT (XK+25,170),3,0
  75. 1740    GOSUB *ROL
  76. 1750    LOAD@ "DEKITA_F.SND",KOE%:PCMPLAY KOE%,127:WAIT 123
  77. 1760 RETURN
  78. 1770 '
  79. 1780 *KAZU
  80. 1790  NO=NO+1:Z=0:DM=0:D$="":DM$="":LOCATE X,Y:PRINT SPC(20)
  81. 1800  IF SW=1 AND NO>1 THEN LOAD@ "SINCH.SND",KOE%:PCMPLAY KOE%,127                  :WAIT 53
  82. 1810  IF SW=2 AND NO>1 THEN LOAD@ "TAIGI.SND",KOE%:PCMPLAY KOE%,127                  :WAIT 47
  83. 1820  IF Z=ST THEN 1850 ELSE LOCATE X,Y:D$=INPUT$(1):D=ASC(D$)
  84. 1830  IF 13=D THEN 1850 ELSE LOCATE X,Y:PRINT AKCNV$(D$);
  85. 1840     DM$=DM$+D$:DM=VAL(DM$):X=X+2:Z=Z+1:GOTO 1820
  86. 1850   D$="":IF DM>M THEN X=X-Z*2:GOTO 1790
  87. 1860   D$="":IF DM<S THEN X=X-Z*2:GOTO 1790
  88. 1870 RETURN
  89. 1880 '
  90. 1890 *DOCH
  91. 1900    PUT@A (558,2)-(637,100),S5%,PSET
  92. 1910    PCMPLAY KDOCH%,127:WAIT 30
  93. 1920 '
  94. 1930    FOR I=1 TO 5
  95. 1940     LINE (558,2)-(637,100),OR,%9,BF:WAIT 5
  96. 1950    PUT@A (558,2)-(637,100),S5%,PSET:WAIT 5
  97. 1960    NEXT
  98. 1970 '
  99. 1980   Z$=INKEY$:IF Z$="" THEN 1980
  100. 1990    IF Z$="2" THEN 2020
  101. 2000    IF Z$="0" THEN 2060
  102. 2010    IF Z$="1" THEN 2060 ELSE 1980
  103. 2020     LOAD@ "OWATA_F.SND",KOE%:PCMPLAY KOE%,127:WAIT 73
  104. 2030     CLOSE:CLS:END
  105. 2040 GOTO 1980
  106. 2050 '
  107. 2060   IF SWOV=1 THEN SWOV=0:GOTO 2140
  108. 2070    PUT@A (SX,SY)-(SX+INCX,SY+INCY),S2%,PSET
  109. 2080   SX=0     :SY=354
  110. 2090    PUT@A (SX,SY)-(SX+INCX,SY+INCY),S1%,PSET
  111. 2100    PUT@A (XK,SY0)-(XK+WX,SY0+WY),S3%,PSET
  112. 2110    PAINT (XK+25,170),%7,0
  113. 2120    PUT@A (XK,SY1)-(XK+WX,SY1+WY),S4%,PSET
  114. 2130 '
  115. 2140   LOCATE 50,1:PRINT SPC(20):LOCATE 15,2:PRINT SPC(60)
  116. 2150 IF Z$="1" THEN Z$="":LINE (558,2)-(637,100),PSET,%15,BF
  117. 2160 IF Z$="0" THEN Z$="":GOTO 1980
  118. 2170 RETURN 1220
  119. 2180 '
  120. 2190 *ERRO
  121. 2200   IF ERR=6 AND ERL=1840 THEN RESUME *INIT
  122. 2210   RESUME *INIT
  123. 2220 '
  124. 2230 *ROL
  125. 2240   KG0=INT(115*CM*CM*CM/10000000)
  126. 2250   KG1=INT(145*CM*CM*CM/10000000)
  127. 2260      LOCATE 18,2:PRINT AKCNV$(STR$(KG0))
  128. 2270      LOCATE 30,2:PRINT AKCNV$(STR$(KG1))
  129. 2280 RETURN
  130.